#!/usr/bin/env tclsh


#### Search file in the system ###########
proc locateFile { name preferredPath } {
   switch ::env(SHELL) {
      dos {
        #specific for windows environment
      }
      default {
        return [ locateFileUnix $name $preferredPath]
      }
   }
}

proc locateFileUnix { name preferredPath} {
    #behavior for standard unix
    # find file in preferredPath first
    foreach dir $preferredPath {
      if [file isfile $dir ] { set dir [file dirname $dir] }
      if ![ catch { set results [exec find $dir -name $name ] } error ]  {
        ladd found [split $results \n]
      }
    }
    # use locate command to find files.
    if [ catch { set results [split [exec locate $name] \n] } error ] { set results {}}
    foreach hit $results {
       set filename [lindex [split $hit /] end]
       if [string match $filename $name ] {
          ladd found $hit
       }
    }
    return $found
}

##### Tcl Binary search and setup #####

# get binary position
proc getTclBinaries { { version 8.0 }} {
    global argv0
    if [info exists ::env(_)] {
        set myname $::env(_)
    } elseif [info exists ::env(SUDO_COMMAND)] {
        set myname [lindex $::env(SUDO_COMMAND) 0]
    } else {
        set myname tclsh
    }
    if [string match $myname $argv0] {
	set binaryName $myname
        set myname [exec which tclsh]
    }
    set binaryName [lindex [file split $myname ] end]
    set TCLBINS [list $myname ]  
    # try to locate file with which?
#    set whichresult ""
#    if {![ catch { set whichresult [exec which $binaryName ] } ] } { ladd TCLBINS $whichresult }
    ladd TCLBINS [locateFile $binaryName { /usr/bin /usr/local/bin /opt }]
    #filter none working ones
    set results {}
    foreach bin $TCLBINS {
        set myversion [getTCLVersion $bin]
        set mypatchlevel [getTClPatchLevel $bin]
        if {$version <= $myversion} {
            lappend result [list $bin $myversion $mypatchlevel]
         }
    }
    return $result
}

proc testTclBin {bin} {
#check if binary file is a runable tclsh 
   if [catch { exec echo "puts [expr 1+1];exit" | $bin} error ] {
      return 0
   } 
   return 1
}

proc getTCLVersion {bin } {
#get the version of the TCL binary file 
    switch ::env(SHELL) {
        dos {
          #for dos environment
         }
        default {
            if [catch {
                set version [exec echo "puts \$tcl_version " | $bin]
             }] {
                return -1
            } else {
                return $version 
            }
        }
    }
}
proc getTClPatchLevel {bin} {
#get the tcl patch level  of the binary file 
   switch ::env(SHELL) {
    dos {
      #for dos environment
    }
    default {
    if [catch {
        set patchlevel [exec echo "puts \$tcl_patchLevel " | $bin]
    }] {
       return -1
    } else {
       return $patchlevel
    }
    }
    }
}


##### Tcl.h & tclConfig.sh search and setup #####

# get tclConfig.sh 
proc getTclConfig {{configName tclConfig.sh} {configSearchPath { /opt } }} {
    set configFiles [locateFile $configName $configSearchPath]
    foreach cfgFile $configFiles {
        set version [ getTclInfo $cfgFile TCL_VERSION ]
        set patchlevel [ getTclInfo $cfgFile TCL_PATCH_LEVEL]
        lappend result [list $cfgFile $version $patchlevel]
    }
    return $result
}

# get include position
proc getTclHeader { {includeName tcl.h} {includeSearchPath  { /usr/include /opt /usr/local} }} {
    set headers [locateFile $includeName $includeSearchPath]
    foreach header $headers {
        set myversion [getHeaderVersion $header] 
        set mypatchlevel [getHeaderPatchLevel $header]
        puts "$header $myversion $mypatchlevel"
        if { $myversion > 0 } {lappend result [list $header $myversion $mypatchlevel] }
    }
    return $result
}



# get info from tclconfig file
proc getTclInfo { tclconfig INFO } {
   set value [ exec bash -c "source $tclconfig ; echo \$$INFO" ]
   return $value
}

#get the tcl version of the given tcl.h header file 
proc getHeaderVersion { header } {
#if failed , return  0.
   set h [open $header r]
   foreach line [split [read $h] \n] {
      if {[regexp  -- {\#define\s+TCL_VERSION\s+\"([.\d\w]+)\"} $line matched version]  } {
         return $version
      }
   }
   return -1
}
proc getHeaderPatchLevel { header } {
   set h [open $header r]
   foreach line [split [read $h] \n] {
      if {[regexp  -- {\#define\s+TCL_PATCH_LEVEL\s+\"([.\d\w]+)\"} $line matched patchlevel]  } {
         return $patchlevel
      }
   }
   return -1
}

#### Package installation check ######

proc checkIfPkgInstalled { binary package {version -1}} {
#check if a package is intalled for binary file 
# Example: checkIfPackageInstalled /usr/bin/tclsh TMD >=1.1 
  if {$version > 0 } { set package "$package $version"}
  if [catch {set version [exec echo "package require $package" | $binary ]} error ] {
   # puts "no"
    return 0
  } else {
   # puts "yes"
    return 1
  }
}

proc checkPkgSearchPath { bin} {
#get the package auto search path  of the binary file 
   switch ::env(SHELL) {
    dos {
      #for dos environment
    }
    default {
        set autopath [exec echo "puts \$auto_path " | $bin]
        return $autopath
    }
    }

}


#### Wrapping source code for installation #####
proc scanDirForPkg {} {}
proc scanPkgFor {} {}
#### Wrapping exetension source code for compilation #####
proc genConfigure {} {}
proc genMakefile {} {}

### User Interface ######
proc untilConfirmed {  block args} {
    set argc [llength $args]
    set myformat {Selected @0 , correct [@yes/@no]? }
    set idx [lsearch $args -format ]
    if { $idx >= 0 } { 
        if { $idx < [expr $argc -1 ] } {
            set myformat [lindex $args [expr $idx+1]]
        } else {
            error "Wrong args!"
        }
    }
    set myyes Yes
    set myno No
    set result [ uplevel $block ]
    set output [ string map [list @@ $result ] $myformat]
    if {[llength $result] == 0} {set output [string map {@0 ''} $output]}
    for {set j 0 } { $j < [llength $result] } { incr j} { set output [string map [list @$j [lindex $result $j]] $output ] }
    set output [string map [list @yes $myyes] $output]
    set output [string map [list @no $myno] $output]
    puts -nonewline $output
    flush stdout
    gets stdin yes
    if { [string length $yes] == 0} { set yes $myyes }
    if { [string match -nocase $yes $myyes]} { 
        return $result 
    } else {
       return [ untilConfirmed $block $args ]
    }
}
proc askinput { args } {
    set argc [llength $args]
    # question
    set idx [lsearch $args -question ]
    if { $idx >= 0 } { 
        if { $idx < [expr $argc -1 ] } {
            set myquestion [lindex $args [expr $idx+1]]
        } else {
            error "Wrong args!"
        }
    }
    set default 0
    set idx [lsearch $args -default] 
    if { $idx >= 0 } {
        if { $idx < [expr $argc -1 ] } {
            set default [lindex $args [expr $idx+1]]
        } else {
            error "Wrong args!"
        }
    }
    set idx [lsearch $args -format] 
    set myformat {[@i] @@}
    if { $idx >= 0 } {
        if { $idx < [expr $argc -1 ] } {
            set myformat [lindex $args [expr $idx+1]]
        } else {
            error "Wrong args!"
        }
    }
    if [info exists myquestion] {puts -nonewline $myquestion }
    flush stdout
    gets stdin ans 
    return $ans
}
proc askOneSelection { options args } {
    set argc [llength $args]
    # question
    set idx [lsearch $args -question ]
    if { $idx >= 0 } { 
        if { $idx < [expr $argc -1 ] } {
            set myquestion [lindex $args [expr $idx+1]]
        } else {
            error "Wrong args!"
        }
    }
    set default 0
    set idx [lsearch $args -default] 
    if { $idx >= 0 } {
        if { $idx < [expr $argc -1 ] } {
            set default [lindex $args [expr $idx+1]]
        } else {
            error "Wrong args!"
        }
    }
    set idx [lsearch $args -format] 
    set myformat {[@i] @@}
    if { $idx >= 0 } {
        if { $idx < [expr $argc -1 ] } {
            set myformat [lindex $args [expr $idx+1]]
        } else {
            error "Wrong args!"
        }
    }
    set idx [lsearch $args -or-input] 
    set allowuserinput false
    if { $idx >= 0 } {
        set allowuserinput true
    }
    set i 0
    if [info exists myquestion] {puts $myquestion }
    foreach opt $options {
        set output [ string map [list @@ $opt] $myformat]
        set output [ string map [list @i $i] $output]
        for {set j 0 } { $j < [llength $opt] } { incr j} { set output [string map [list @$j [lindex $opt $j]] $output ] }
        puts $output
        incr i
    }
    if $allowuserinput {
        puts -nonewline "Please make a selection above, or type a new value\[default: $default\]:"
        flush stdout
        gets stdin selection
        if { [string length $selection] == 0} {set selection 0}
        if { ![string is integer $selection] } {set result $selection;set selection -1}
        while { $selection <-1 || $selection > [expr 1+[llength $options]]} {
            puts "Input incorrect!, select again:" 
            puts -nonewline "Please make a selectiob above, \[default: $default\]:"
            flush stdout
            gets stdin selection
            if { [string length $selection] == 0} {set selection 0}
            if { ![string is integer $selection] } {set result $selection;set selection -1}
        }
        if { $selection >= 0} { set result [lindex $options $selection]}
        return $result
    } else {
        puts -nonewline "Please make a selection above, \[default: $default\]:"
        flush stdout
        gets stdin selection
        if { [string length $selection] == 0} {set selection 0}
        if { ![string is integer $selection] } {set selection -1}
        while { $selection <0 || $selection > [expr 1+[llength $options]]} {
            puts "Input incorrect!, select again:" 
            puts -nonewline "Please make a selectio above,  \[default: $default\]:"
            flush stdout
            gets stdin selection
            if { [string length $selection] == 0} {set selection 0}
            if { ![string is integer $selection] } {set selection -1}
        }
        return [lindex $options $selection]
      }

}
proc askMultiSelection { options } {
    set argc [llength $args]
    # question
    set idx [lsearch $args -question ]
    if { $idx >= 0 } { 
        if { $idx < [expr $argc -1 ] } {
            set myquestion [lindex $args [expr $idx+1]]
        } else {
            error "Wrong args!"
        }
    }
    set default 0
    set idx [lsearch $args -default] 
    if { $idx >= 0 } {
        if { $idx < [expr $argc -1 ] } {
            set default [lindex $args [expr $idx+1]]
        } else {
            error "Wrong args!"
        }
    }
    set idx [lsearch $args -format] 
    set myformat {[@i] @@}
    if { $idx >= 0 } {
        if { $idx < [expr $argc -1 ] } {
            set myformat [lindex $args [expr $idx+1]]
        } else {
            error "Wrong args!"
        }
    }
    set i 0
    if [info exists myquestion] {puts $myquestion }
}
#### Package installation #########
proc installPkgfor { bin pkgs  } {
# install package from srcdir to dir 
    set path [lindex [checkPkgSearchPath $bin] 0 ] 
    installPkgTo $path $pkgs
}
proc installPkgTo { dest pkgs } {
#    if ![file exists $dest] { puts "Cannot install packages:\n$dest not exists!"; exit }
#    if ![file isdirectory $dest ] { error "Cannot install packages:\n$dest is not a directory!" }
    foreach {pkg pkgPath} $pkgs {
        set destpath [toAbsolute $dest ]
        if [catch { exec mkdir -p $destpath
                    exec cp -rvf $pkgPath $destpath/$pkg } error ] {
            puts "Cannot install package $pkg into $dest:\n[lindex [split $error \n] 0]"
	        puts -nonewline "Install to another Location? \[yes/no\]:"
	        flush stdout
	        gets stdin yes
       	    if { [string length $yes] == 0} { set yes yes }
            if { [string match -nocase $yes yes]} {
                set dest [untilConfirmed { askinput -question "Input a path to install: " } -format "Install into @0?"]
                installPkgTo $dest $pkgs 
    	    }
#            puts "Please copy the directory $pkgPath into a separate directory you have right to write into and add a line in your ~/.tclshrc :\n lappend auto_path /path/TMD/installed. "
#            exit
        } else {
                puts $error
                set tclrc [open ~/.tclshrc a ]
                puts $tclrc "set auto_path \[concat $dest \$auto_path\]" 
                close $tclrc
        }
    }
}
proc filecopy {src dest} {
    set old [pwd]
    if ![file exists $dest] { exec mkdir -p $dest
        puts $dest 
    }
    puts $old 
    puts $src
    puts $dest 
    cd $src 
    set output ""
    foreach f [glob *] {
        cd $old
        exec cp -r $src/$f $dest/
        append output "cp $src/$f -> $dest/$f\n"
    }
    return $output
}
proc runInstallationFromFile {pkgFile} {}
proc runInstallationFromDir {pkgDir} {}
proc runInstallationFromRepo {pkg repo} {}


####################################
# Basic helper functions
####################################

# add none repetitive result
proc ladd { list values } {
    upvar $list L
    if ![info exists L] { set L {} }
    foreach value $values {
        if { [lsearch $L $value ] < 0 } { uplevel 1 "lappend $list $value" }
    }
}

## make ~/ works in exec mkdir ...
proc toAbsolute { path } {
    set old [pwd]
    cd ~/
    set homepath [pwd]
    cd $old
    return [file join [pwd] [ regsub {^~/} $path $homepath/] ]
}

################################
# test Program
################################



# TODO add option -top , for example: [getTCLBinaries -top]

#set tclheader [untilConfirmed { askOneSelection [getTclHeader] -question "Current System has following Tcl header files:" -format {    [@i] header @0} -or-input } ]
#set tclconfig [untilConfirmed { askOneSelection [getTclConfig] -question "Current System has following Tcl input files:" -format {    [@i] header @0}}]

# TODO where to put example/demo, document file ...etc.

 
# TODO add UI for installation
# TODO add code for packing pkg for installation(auto compile, pack and generate install file).
#catch {installPkgfor /usr/bin/tclsh {TMD pkg/TMD} } error 
#puts $error
#catch {installPkgTo /home/yi/tclpkg  {TMD pkg/TMD} } error
## TODO test installation with test
#puts $error
#exit

################################
# Start Program
################################
puts "Searching for Tcl Bins..."
set tclbin [untilConfirmed { askOneSelection [getTclBinaries 8.4] -question "Current System has following Tcl Binary files, Select one to install package for:" -format {    [@i] binary path: @0 , Version: @1, Patch Level: @2} } ]
lassign $tclbin bin v p
if ![checkIfPkgInstalled $bin TMD ] {
    installPkgfor $bin {TMD pkg/TMD}
} else {
    puts "Already have TMD installed!"
    installPkgfor $bin {TMD pkg/TMD}
}
puts "Install finished.\nPlease check the examples directory for usage details."
# Output installation information.


# confirm copying file to pkg directory

# copying pkg into lib 


